home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
doors_1
/
fd200.zip
/
FD_DISP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-02-27
|
6KB
|
301 lines
procedure set_x_y;
var i, j : integer;
begin
for i := 0 to 4 do
for j := 0 to 14 do
x_y[i,j] := 649 + 30*i + 160*j;
end;
procedure clear_attr;
var i : integer;
attr : integer;
begin
attr := norm_b SHL 4 + norm_f;
video_disable;
for i := 0 to 13 do
video[x_y[x,y] + i SHL 1] := attr;
video_enable;
end;
procedure show_attr;
var i : integer;
attr : integer;
begin
attr := brite_b SHL 4 + brite_f;
video_disable;
for i := 0 to 13 do
video[x_y[x,y] + i shl 1] := attr;
video_enable;
end;
procedure go_up;
begin
clear_attr;
y := y - 1;
if ( y < 0) then
begin y := 14;
x := x - 1;
if x < 0 then x := 4;
end;
end;
procedure go_dwn;
begin
clear_attr;
y := y + 1;
if y = 15 then
begin y := 0;
x := x + 1;
if x = 5 then x := 0;
end;
end;
procedure go_left;
begin
clear_attr;
x := x - 1;
if x < 0 then
begin x := 4;
y := y - 1;
if y < 0 then y := 14;
end;
end;
procedure go_right;
begin
clear_attr;
x := x + 1;
if x = 5 then
begin x := 0;
y := y + 1;
if y = 15 then y := 0;
end;
end;
procedure clear_section;
begin
normcolor;
gotoxy(25,11);
write(' ');
end;
procedure disp_section(s : section_type);
begin
clear_section;
gotoxy(25,11);
write(s:15);
hide_cursor;
end;
function section: section_type;
var skey: char;
i : integer;
country : section_type;
begin
if auto_section = TRUE
then begin
save_screen;
video_disable;
move(image2,video,4000);
video_enable;
hide_cursor;
repeat
show_attr;
skey := readkey;
case skey of
#72 : go_up;
#80 : go_dwn;
#75 : go_left;
#77 : go_right;
end;
until skey = #13;
if sections[y,x] = 'OTHER' then
begin
gotoxy(10,23);
write('Enter Country : xxxxxxxxxxxxxxx');
for i := 0 to 14 do write(#8);
readln(country);
end
else country := sections[y,x];
UpperCase(country);
section := country;
restore_screen;
end
else begin
clear_section;
gotoxy(25,11);
readln(country);
UpperCase(country);
section := country;
end;
end;
procedure found_it;
var note,
i,
attr : integer;
begin
attr := brite_b SHL 4 + brite_f;
video_disable;
for i := 0 to 5 do
video[1613 + i shl 1] := attr;
video_enable;
gotoxy(32,4); brite_color;
write('D U P L I C A T E');
hide_cursor;
normcolor;
for note := 1 to 3 do
begin
if tunes = TRUE then sound(660); delay(100);
if tunes = TRUE then sound(440); delay(100);
end;
nosound;
attr := norm_b SHL 4 + norm_f;
video_disable;
for i := 0 to 5 do
video[1613 + i SHL 1] := attr;
video_enable;
gotoxy(32,4); ClrEol;
hide_cursor;
end;
procedure clear_callsign;
begin
normcolor;
gotoxy(7,11);
write(' ');
tbranch^.leaf.callsign := '';
end;
procedure disp_callsign(c : callsign_type);
begin
clear_callsign;
gotoxy(7,11);
write(c : 6);
hide_cursor;
end;
function enter_callsign: callsign_type;
var callsign : callsign_type;
begin
callsign := '';
clear_callsign;
gotoxy(7,11);
readln(callsign);
UpperCase(callsign);
while length(callsign) < 6 do callsign := ' ' + callsign;
disp_callsign(callsign);
enter_callsign := callsign;
end;
procedure clear_class;
begin
normcolor;
gotoxy(18,11);
write(' ');
tbranch^.leaf.class := ' ';
end;
procedure disp_class( c : class_type);
begin
clear_class;
gotoxy(18,11);
write(c : 3);
hide_cursor;
end;
function enter_class: class_type;
var d_class : class_type;
begin
d_class := '';
clear_class;
gotoxy(18,11);
readln(d_class);
UpperCase(d_class);
disp_class(d_class);
enter_class := d_class;
end;
procedure disp_mode;
begin
normcolor;
gotoxy(43,11);
case op_mode of
CW : write(' CW ');
AM : write(' AM ');
FM : write(' FM ');
SSB : write(' SSB ');
RTTY : write(' RTTY ');
AMTOR : write('AMTOR ');
PACKET : write('PACKET');
end;
hide_cursor;
end;
procedure change_mode;
begin
normcolor;
op_mode := succ(op_mode);
if op_mode = M_END then op_mode := CW;
disp_mode;
end;
procedure disp_band;
begin
gotoxy(51,11);
case band of
B160 : write('160');
B80 : write(' 80');
B40 : write(' 40');
B20 : write(' 20');
B15 : write(' 15');
B10 : write(' 10');
B6 : write(' 6');
B2 : write(' 2');
B220 : write('220');
B440 : write('440');
end;
hide_cursor;
end;
procedure change_band;
begin
band := succ(band);
if band = B_END then band := B160;
disp_band;
end;
procedure clear_all;
begin
clear_callsign;
clear_class;
clear_section;
tbranch^.leaf.section := ' ';
hide_cursor;
end;
procedure date_time;
begin
if tbranch^.leaf.time <> time then
begin
normcolor;
gotoxy(59,11);
write(date);
tbranch^.leaf.date := date;
gotoxy(70,11);
write(time);
tbranch^.leaf.time := time;
hide_cursor;
end;
end;
procedure disp_score;
begin
normcolor;
gotoxy(33,14); write(contacts[ord(band)]:4);
gotoxy(48,14); write(total_contacts:4);
gotoxy(63,14); write(score:5);
hide_cursor;
end;